open Aws_shared.Misc
open Aws_shared.Types
open Aws_shared.Result 

open CalendarLib

let get_date () = 
  let date = Date.today () in
  let time = Time.now () in
  let date_s = Printer.Date.sprint "%a, %d %b %Y" date in    
  let time_s = Printer.Time.sprint " %H:%M:%S %z" time in 
   date_s ^ time_s 
    
     
module Put = 
  struct 
    let raw_exec connection bucket key ?(contenttype="text/html") content = 
      
      let date = get_date () in
	
      let string_to_sign = Printf.sprintf "PUT\n\n%s\n%s\n/%s/%s" contenttype date bucket key in
	display "@@@ String to sign: %s\n" string_to_sign ; 
      let hasher = Cryptokit.MAC.hmac_sha1 connection.secret_access_key in
      let hashed = Cryptokit.hash_string hasher string_to_sign in
      let encoder = Cryptokit.Base64.encode_multiline () in 
      let signature = Cryptokit.transform_string encoder hashed in
      let signature = String.sub signature 0 (String.length signature - 1) in
	
      let authorization = Printf.sprintf "AWS %s:%s" connection.access_key_id signature in
     
      let headers = 
	[ 
	  "Content-Length", (String.length content >>> string_of_int); 
	  "Content-Type", contenttype; 
	  "Authorization", authorization; 
	  "Date", date; 
	  "Transfer-Encoding", ""
	] in
	
      let headers = List.map (fun (k,v) -> k^": "^v) headers in

      let writer accum data =
	Buffer.add_string accum data;
	String.length data in
	
      let counter = ref 0 in 

      let reader str maxBytes =
	let readBytes = min (String.length str - !counter) maxBytes in
	  if readBytes = 0 then ""
	  else 
	    (
	      let c = !counter in
		counter := !counter + readBytes;
		String.sub str c readBytes) in
	
      let connection = Curl.init () in
	
	Curl.setopt connection (Curl.CURLOPT_URL (Printf.sprintf "http://%s.s3.amazonaws.com/%s" bucket key));
	Curl.setopt connection (Curl.CURLOPT_PUT true) ; 

	Curl.setopt connection (Curl.CURLOPT_HTTPHEADER headers); 
	Curl.setopt connection (Curl.CURLOPT_READFUNCTION (reader content));  
	  
	let result = Buffer.create 16384 in

	  Curl.set_writefunction connection (writer result);
	  Curl.perform connection; 
	  Curl.cleanup connection; 
	  Buffer.contents result 
	    

  end


module Get = 
  struct 
    let raw_exec connection bucket key = 
        
      let date = get_date () in
	
      let string_to_sign = Printf.sprintf "GET\n\n\n%s\n/%s/%s" date bucket key in

      let hasher = Cryptokit.MAC.hmac_sha1 connection.secret_access_key in
      let hashed = Cryptokit.hash_string hasher string_to_sign in
      let encoder = Cryptokit.Base64.encode_multiline () in 
      let signature = Cryptokit.transform_string encoder hashed in
      let signature = String.sub signature 0 (String.length signature - 1) in
	
      let authorization = Printf.sprintf "AWS %s:%s" connection.access_key_id signature in
	
      let headers = 
	[ 
	  "Authorization", authorization; 
	  "Date", date; 
	  "Transfer-Encoding", ""
	] in
	
      let headers = List.map (fun (k,v) -> k^": "^v) headers in
	
      let writer accum data =
	Buffer.add_string accum data;
	String.length data in
	
      let connection = Curl.init () in
	
	Curl.setopt connection (Curl.CURLOPT_URL (Printf.sprintf "http://%s.s3.amazonaws.com/%s" bucket key));
	Curl.setopt connection (Curl.CURLOPT_HTTPHEADER headers);

		
	let result = Buffer.create 16384 in
	  
	  Curl.set_writefunction connection (writer result);
	  Curl.perform connection; 
	  Curl.cleanup connection; 
	  Buffer.contents result 

  end



module StringRequest =
struct 
  let create connection verb content_md5 content_type amz_headers ressource = 
    let expires = Int64.of_float (Unix.time () +. 36.0 *. 3600.0) in
    let string_to_sign = 
      Printf.sprintf "%s\n%s\n%s\n%Ld\n%s%s" 
	(match verb with `POST -> "POST" | `GET -> "GET" | `PUT -> "PUT")
	content_md5 
	content_type 
	expires 
	amz_headers ressource in
    Printf.printf "%s\n" string_to_sign ;
    let hasher = Cryptokit.MAC.hmac_sha1 connection.secret_access_key in
    let hashed = Cryptokit.hash_string hasher string_to_sign in
    let encoder = Cryptokit.Base64.encode_multiline () in 
    let signature = Cryptokit.transform_string encoder hashed in
    let signature = String.sub signature 0 (String.length signature - 1) in

    let request = Printf.sprintf "AWSAccessKeyId=%s&Signature=%s&Expires=%Ld" connection.access_key_id (Netencoding.Url.encode signature) expires in  
    request 
end

module InitiateMultipart = 
  struct 
    let raw_exec ?(contenttype="text/html") connection bucket key =

      let date = get_date () in
      
      let string_to_sign = Printf.sprintf "POST\n\n%s\n%s\n/%s/%s?uploads" "" date bucket key in
	display "@@@ String to sign: %s\n" string_to_sign ; 
      let hasher = Cryptokit.MAC.hmac_sha1 connection.secret_access_key in
      let hashed = Cryptokit.hash_string hasher string_to_sign in
      let encoder = Cryptokit.Base64.encode_multiline () in 
      let signature = Cryptokit.transform_string encoder hashed in
      let signature = String.sub signature 0 (String.length signature - 1) in
	
      let authorization = Printf.sprintf "AWS %s:%s" connection.access_key_id signature in
     
      let headers = 
	[ 
	  "Content-Type", contenttype; 
	  "Authorization", authorization; 
	  "Date", date; 
	  "Transfer-Encoding", ""
	] in
	
      let headers = List.map (fun (k,v) -> k^": "^v) headers in

      let writer accum data =
	Buffer.add_string accum data;
	String.length data in
	
      let connection = Curl.init () in
	
	Curl.setopt connection (Curl.CURLOPT_URL (Printf.sprintf "http://%s.s3.amazonaws.com/%s?uploads" bucket key));
	Curl.setopt connection (Curl.CURLOPT_HTTPPOST []); 

	Curl.setopt connection (Curl.CURLOPT_HTTPHEADER headers); 
	  
	let result = Buffer.create 16384 in

	  Curl.set_writefunction connection (writer result);
	  Curl.perform connection; 
	  Curl.cleanup connection; 
	  Buffer.contents result 
	    
    let exec connection bucket key = 
      let result = raw_exec connection bucket key in 
      let upload_id = 
	match Xml.parse_string result with
	    Xml.Element (_, _, Xml.Element (_,_,_) :: Xml.Element (_,_,_) :: Xml.Element (_,_,Xml.PCData upload_id :: _) :: _) -> 
	      upload_id 
	  | _ -> raise Malformed in
      upload_id 
  end


